SUBROUTINE TRNSP(IT,TR)
	COMMON /PX/KPN(1) /Q/Q(1) /XRN/RN(1) /STF/RFAC(1) /LLL/LEND
CC	DIMENSION JSIG(14)
CC	DATA JSIG/4,1,5,2,6,3,0,0,3,6,2,5,1,4/

	KSIG=99
	SIG=0
	NSIG=-1
	SLUR=0
	PRX=99
	MS=0
	TTR=AMOD(TR,7.0)
	K=1
	DO 47 L=1,IT
	J=KPN(L)
	X=Q(J+1)
	IF(X.EQ.17)GO TO 199
C  FOUND KSIG, SO DON'T DO THE REST
	IF(X.EQ.3)MS=L
C  REMEMBER WHERE CLEF IS
47	IF(X.LT.3)GO TO 41
C  LEAVE LOOP IF WE'VE GONE TOO FAR.
41	IF(TTR.EQ.0)GO TO 199
	TYPE 42
42	FORMAT(' ADD KEY SIG? -- ',$)
43	FORMAT(A1)
	ACCEPT 43,X
	IF(X.NE.'Y')GO TO 199
C  NEXT EXPANDS DATA.  PUT THIS IN FAIL LATER
	J=KPN(MS+1)
	L=KPN(IT)+7
	DO 45 N=L,J,-1
45	Q(N+7)=Q(N)
	DO 46 N=IT+2,MS+1,-1
46	KPN(N+1)=KPN(N)+7
	L=KPN(MS+1)
	Q(L)=4
	Q(L+1)=17
CC  IT'S ALREADY 0 *****	Q(L+2)=0
	Q(L+3)=7*RFAC(9)
	Q(L+4)=0
	Q(L+5)=0
C  THIS WILL BE CHANGED LATER.
	Q(L+6)=CLFNUM(Q,KPN,MS)
C GETS THE CLEF NUM.
CC	KPN(MS+1)=KPN(MS)+6
	IT=IT+1
	LEND=IT+1
	CALL EXPND(MS,0)
C  2ND ARG IS DUMMY -- LINE IS SHIFTED TO RT.

199	J=KPN(K)
	X=Q(J+1)
	IF(X.EQ.1)GO TO 1
	IF(X.NE.3)GO TO 2
	CLEF=Q(J+5)
	IF(Q(J).LT.3)CLEF=0
	IF(TR.NE.4)GO TO 21
C NEXT FOR HORN IN F CLEF CHANGES
	IF(CLEF.GE.100)CLEF=CLEF-100
C HORN CLEF CHANGES ARE KEPT, BS. CL'S ARE THROWN AWAY
21	IF(TR.NE.8)GO TO 100
C  NEXT FOR BASS CL. CLEF CHANGES.
	IF(CLEF.NE.0)Q(J+5)=0
	IF(CLEF.LT.100)GO TO 100
CC	Q(J+1)=1089.
	CALL SHRNK(K,IT)
C  MAKE IT INVISIBLE IF IT WAS MINI.
	CLEF=CLEF-100
	GO TO 199
2	IF(X.NE.4)GO TO 20
	BAR=-1
	MS=1
	GO TO 100
20	IF(X.NE.17)GO TO 12
C  HOW ABOUT CHANGE TO NO SIG?  OK, CODE =99
	NSIG=0
2000	ADD=2
	IF(TR.EQ.4)ADD=1
	IF(TR.EQ.2)ADD=-3
C 4=F, 3=G, 2=A, -2=E FLAT
	IF(TR.EQ.-2)ADD=3
	IF(TR.EQ.3)ADD=-1
	IF(TTR.EQ.0)ADD=0
	R=0
	IF(X.EQ.17)R=Q(J+5)
	SIG=R
	R=ADD+R
	KSIG=R
C  FOR LATER CHECKS
C  TO USE IN IMPROVED ROUTINE
C*******  ADD NO-YES SIG FEATURE *******
	IF(X.EQ.1)GO TO 1000
	Q(J+5)=R
	IF(R.NE.0)GO TO 399
	CALL SHRNK(K,IT)
	K=K-1
CC	IF(ADD.EQ.0)Q(J+1)=1089.
C  CHANGE CODE TO 99 IF NO SIG.(1089.=11.*99.)
399	IF(CLEF.NE.1)GO TO 100
C  ONLY FOR BASS CLEF KSIGS (FR. HORN, BASS CLAR)
	R=CLEF
	IF(TR.EQ.8)R=0
	Q(J+6)=R
	GO TO 100
12	IF(X.EQ.5)GO TO 120
	IF(X.NE.6)GO TO 100
120	RT=TR
	IF(RT.NE.8)GO TO 121
	IF(CLEF.EQ.1)RT=-4
121	Q(J+4)=Q(J+4)+RT
	Q(J+5)=Q(J+5)+RT
	IF(X.EQ.5)SLUR=Q(J+6)
C  SAVES RIGHT POS. OF SLUR
	GO TO 100
C  FOR BEAMS AND SLURS

1	IF(KSIG.EQ.99)GO TO 2000
1000	RT=TR
	R=Q(J+4)
	RX=AMOD(R,100.0)
	RZ=AMOD(RX,7.0)
C  THE NOTE NUM
	R5=Q(J+5)
	A=AMOD(R5,10.0)
C  THE ACCI
	RN(MS)=A
	RN(MS+1)=RX
C  SAVE FOR REPEATS
	MS=MS+2
	CHNAT=3
	IF(MS.LT.4)GO TO 205
	N=MS-3
200	IF(RX.NE.RN(N))GO TO 201
	IF(A.EQ.0)GO TO 204
C  NOW WE'VE FOUND THE SAME NOTE WITH NO ACCI IN SAME MEAS.
	IF(A.EQ.RN(N-1))GO TO 204
	GO TO 203
204	IF(TR.NE.8)GO TO 4
	IF(CLEF.EQ.1)RT=RT-12
C  FOR BSCLAR
	GO TO 4
201	N=N-2
	IF(N.GT.0)GO TO 200
205	IF(NSIG)CHNAT=0
203	ADD=A
C  THE CHANGE IN ACCI
	IF(PRX.NE.RX)GO TO 44
C IF PREV ACCI AND NT ARE SAME, SKIP OVER.
	IF(A.NE.0)GO TO 44
C NOW SAME NOTE, NO ACCI
	IF(ABS(SLUR-Q(J+3)).GT.3)GO TO 44
C  FOUND CONNECTING TIE
CC	IF(BAR.EQ.0)GO TO 204
C THIS ↑↑↑↑ ALWAYS PUTS ACCI AFTER A BAR -- EVEN WITH TIE------
C OR SET MS BACK TO 1 WHEN TIE IS PRESENT.  THIS WILL
CAUSE LATER SAME NOTE TO HAVE ACCI (I HOPE.)
	IF(BAR)MS=1
	GO TO 204
44	IF(NSIG)GO TO 440
	IF(A.EQ.0)GO TO 443
C  ONLY CHECKS ON MOTES WITH NO ACCI

440	IF(TR.NE.1)GO TO 5
C  NEXT FOR B-FLAT TRANSPOSITIONS
9	IF(RZ.EQ.0)GO TO 7
	IF(RZ.NE.3)GO TO 4
C NOW FOUND A B OR E
7	IF(A.EQ.0)GO TO 70
	IF(A.NE.3)GO TO 71
C  CHNG NO ACCI OR NAT TO SHARP
70	ADD=2
71	IF(A.EQ.1)GO TO 30
C  CHNG FLAT TO NAT.
	IF(A.NE.2)GO TO 3
C  NEXT FOR B#, E#
	RT=RT+1
C  MOVE IT UP A STEP
30	ADD=CHNAT
C  MAKE IT NAT. IF NEEDED
3	Q(J+5)=R5-A+ADD
4	PRX=RX
40	Q(J+4)=R+RT
	BAR=0
	GO TO 100

443	IF(CLEF.NE.1)GO TO 4
5	IF(TR.NE.4)GO TO 6
C FOUND "F" TRANS.
	IF(CLEF.EQ.1)GO TO 60
C  MAKE ADJUSTMENT FOR BASS CLEF
8	IF(RZ.EQ.0)GO TO 7
	GO TO 4

6	IF(TR.NE.8)GO TO 10
C NEXT FOR BSCLAR.---ADD OTHERS HERE!!!
	IF(CLEF.NE.1)GO TO 61
60	RZ=RZ-5
	IF(RZ)RZ=RZ+7
	IF(TR.EQ.4)GO TO 8
	RT=RT-12
61	IF(NSIG)GO TO 9
	IF(A.NE.0)GO TO 9
	GO TO 4
10	IF(TR.NE.2)GO TO 11
	IF(RZ.EQ.1)GO TO 101
	IF(RZ.EQ.4)GO TO 101
	IF(RZ.NE.5)GO TO 4
C  FOR "A".  FINDS C,F AND G.
101	IF(A.EQ.0)GO TO 102
	IF(A.NE.3)GO TO 103
C  FINDS NO ACCI OR NAT.
102	ADD=1
103	IF(A.EQ.2)GO TO 30
	GO TO 3
11	IF(TR.NE.3)GO TO 110
	IF(RZ.NE.4)GO TO 4
	ADD=1
C  "G"   F→Bb, F#→B NAT.
	IF(A.EQ.2)GO TO 30
C  NOTHING FOR bb OR ## YET
	GO TO 3
110	IF(TR.NE.-2)GO TO 4
C  IF NOT -2 IT IS NOW THOUGHT TO BE SOME OCTAVE SHIFT.
	IF(RZ.EQ.3)GO TO 111
	IF(RZ.EQ.0)GO TO 111
	IF(RZ.NE.6)GO TO 4
111	IF(A.EQ.0)GO TO 112
	IF(A.NE.3)GO TO 113
112	ADD=2
113	IF(A.EQ.1)GO TO 30
C  FOR Eb TRNS
	GO TO 3
100	IF(K.GE.IT)GO TO 299
	K=K+1
	GO TO 199
299	CALL RVRS(IT)
C  TO REVERSE STEMS, BEAMS AND SLURS
	END



	SUBROUTINE RVRS(IT)
	COMMON /PX/KPN(1) /Q/Q(1) /XRN/RN(1)
	K=1

1	J=KPN(K)
	R=Q(J+1)
	IF(R.NE.1)GO TO 2
C  JUMP IF NOT A NOTE
	IF(Q(J+5).LT.10)GO TO 10
C  JUMP IF NO STEM ON IT
	KK=K+1
3	IF(KK.GT.IT)RETURN
	JJ=KPN(KK)
	RR=Q(JJ+1)
	IF(RR.NE.1)GO TO 5
C  JUMP IF NOT A NOTE
	IF(Q(JJ+5).GE.10)GO TO 6
C SKIP CHORD NOTES (NO STEM)
7	KK=KK+1
	GO TO 3
C DID NOT FIND BEAM NEARBY
6	RZ=AMOD(Q(J+4),100.0)
	N=J+5
	A=10
	IF(RZ.GE.7)GO TO 60
	IF(Q(N).LT.20)GO TO 10
C NOW STEM SHOULD BE DOWN IF WITHOUT BEAM OR 1ST NT UNDER BEAM.
	A=-A
	GO TO 15
60	IF(Q(N).GE.20)GO TO 10
C  THERE MUST BE A BETTER WAY!
15	Q(N)=Q(N)+A
	GO TO 10
8	IF(Q(N).LT.20)GO TO 10
	A=-A
C  STEM UP
	GO TO 15
5	IF(RR.NE.6)GO TO 6
20	B=Q(JJ+4)
	C=Q(JJ+5)
	D=(B+C)/2.
	IF(RR.EQ.5)GO TO 9
	IF(RR.NE.6)GO TO 10
	B=Q(JJ+6)+1.
C  SAVES RANGE OF BEAM +1.
	IF(Q(JJ+7).GE.20)GO TO 11
C  NOW STEMS ARE UP
	IF(D.LT.7)GO TO 12
C JUMP TO 12 IF ALL OK
CC	C=-10
	JSTM=0 
C SAVE FOR REVERSED STEMS
	GO TO 23
11	IF(D.GE.7.)GO TO 12
C  STEMS DOWN
C JUMP IF NO REVERSE NEEDED
	JSTM=-1
23	JH=0
	CHNG=0
	DO 16 N=K,IT
	KK=KPN(N)
	IF(Q(KK+3).GT.B)GO TO 140
	R=Q(KK+1)
	IF(R.NE.1)GO TO 17
	L=5
	R=Q(KK+8)
C  THE STEM LENGTH
	IF(R.EQ.999)R=0
	Q(KK+8)=-R
C  FOR THE INVERSION
19	C=10.
	A=Q(KK+L)
	IF(A.GE.20)C=-C
	Q(KK+L)=C+A
	IF(JH.NE.0)GO TO 161
C NEXT FOR 1ST NOTE UNDER BEAM
	JH=4
160	R=Q(JJ+JH)-Q(KK+4)
	C=-1 
	IF(JSTM)GO TO 163
	C=R
	R=1
C NOW STEMS UP
163	IF(R.GT.C)GO TO 162
C JUMP IF BEAM IS NOT TOO CLOSE TO NOTE
	CHNG=C-R
	IF(JSTM.EQ.0)CHNG=-CHNG
	JH=JJ+4
	Q(JH)=Q(JH)+CHNG
	JH=JH+1
	Q(JH)=Q(JH)+CHNG
162	IF(L)GO TO 141
C  FOR ESCAPE FROM LOOP
161	JH=KK
C  JH SAVES PTR TO LAST NOTE UNDER BEAM
	GO TO 16
17	IF(R.NE.6)GO TO 18
C NOW IT'S A BEAM
	L=7
	GO TO 19
18	IF(R.NE.5)GO TO 16
C NOW IT'S A SLUR
	C=-4
	IF(Q(KK+7))C=-C
	CALL SLRV(KK,C)
C  TO REVERSE SLUR
CC	Q(KK+7)=-Q(KK+7)
16	CONTINUE
C  SHOULD ALWAYS EXIT FROM LOOP BEFORE END OF ARRAY!
140	KK=JH
	L=-1
	JH=5
C GO BACK TO CHECK HGT OF LAST NOTE AND RIGHT END OF BEAM
	GO TO 160

141	IF(CHNG.EQ.0)GO TO 14
	IF(CHNG)CHNG=-CHNG
	DO 142 N=K,IT
C  TO READJUST STEMS UNDER REVERSED BEAMS
	KK=KPN(N)
	IF(Q(KK+3).GT.B)GO TO 14
	IF(Q(KK+1).NE.1)GO TO 142
	Q(KK+8)=Q(KK+8)+CHNG
C  THE STEM LENGTH
142	CONTINUE
	GO TO 14

C NEXT FOR SLURS
9	B=-4
	IF(Q(JJ+7))GO TO 24
	IF(D.GT.7)GO TO 10
C JUMP TO LEAVE STEM UP
	GO TO 25
24	IF(D.LT.5)GO TO 10
C JUMP TO LEAVE STEM DOWN
	B=-B
CC25	Q(JJ+4)=Q(JJ+4)+B
CC	Q(JJ+5)=Q(JJ+5)+B
CC	Q(JJ+7)=-R
25	CALL SLRV(JJ,B)
	GO TO 10
12	DO 13 N=K+1,IT
	KK=KPN(N)
13	IF(Q(KK+3).GT.B)GO TO 14
C  JUMP OUT WHEN PAST END OF BEAM.
14	K=N-1
	GO TO 10

2	IF(R.NE.6)GO TO 21
22	JJ=J
	RR=R
	GO TO 20
21	IF(R.EQ.5)GO TO 22
10	IF(K.GT.IT)RETURN
	K=K+1
	GO TO 1
	END